home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 11 / AMUG BBS in a Box Volume XI (April 1994) (MacWizards).iso / Files / Tele / Pete Johnson / GEnie Cleaner.sit / GEnie Cleaner.p < prev    next >
Encoding:
Text File  |  1991-12-20  |  3.6 KB  |  130 lines  |  [TEXT/PJMM]
  1. program GEnieCleaner;
  2.  
  3.     uses
  4.         TextUtils;
  5.  
  6.     const
  7.         ENDLINE = chr(13);
  8.         SPACE = ' ';
  9.         TAB = chr(9);
  10.         DOCTYPE = 'ttxt';
  11.  
  12. {-----------------------------------------------------------------    }
  13.  
  14.     function EndStrip (theString: str255): str255;
  15.  
  16.     begin
  17.         while (theString[length(theString)] in [SPACE, TAB, ENDLINE]) & (length(theString) > 1) do
  18.             theString := copy(theString, 1, pred(length(theString)));
  19.         EndStrip := theString
  20.     end;
  21.  
  22. {-----------------------------------------------------------------    }
  23.  
  24.     function BeginStrip (theString: str255): str255;
  25.  
  26.     begin
  27.         while (theString[1] in [SPACE, TAB, ENDLINE]) & (length(theString) > 1) do
  28.             theString := copy(theString, 2, 255);
  29.         BeginStrip := theString
  30.     end;
  31.  
  32. {-----------------------------------------------------------------    }
  33.  
  34.     function TwoSpaceStrip (theString: str255): str255;
  35.  
  36.     begin
  37.         while (pos('  ', theString) > 1) & (length(theString) > 1) do
  38.             theString := omit(theString, pos('  ', theString), 1);
  39.         TwoSpaceStrip := theString
  40.     end;
  41.  
  42. {-----------------------------------------------------------------    }
  43.  
  44.     procedure ProcessFile (fileName: str255; readRef, vRef: integer);
  45.  
  46.         var
  47.             err: OSErr;
  48.             logLine: str255;
  49.             writeRef, counter: integer;
  50.             FirstLine: boolean;
  51.  
  52.     begin
  53.         Err := FSDelete(fileName, vRef);
  54.         Err := Create(fileName, vRef, DOCTYPE, 'TEXT');
  55.         if Err = NoErr then
  56.             begin
  57.                 Err := FSOpen(fileName, vRef, writeRef);
  58.                 while not AtEOF(readRef) & (Err = NoErr) do
  59.                     begin
  60.                         repeat
  61.                             Err := ReadALine(readRef, logLine);
  62.                         until ((pos('Number:', logLine) = 1) & (pos('Name: ', logLine) > 0)) | AtEOF(readRef) | (Err <> NoErr);
  63.                         if (not AtEOF(readRef)) & (Err = NoErr) then
  64.                             begin
  65.                                 logLine := copy(logLine, pos('Name:', logLine) + length('Name: '), 255);
  66.                                 Err := WrLn(writeRef, logLine);
  67.                                 for counter := 1 to 4 do {junk lines}
  68.                                     if (Err = NoErr) then
  69.                                         Err := ReadALine(readRef, logLine);
  70.                                 Err := WrLn(writeRef, '');
  71.                                 FirstLine := true;
  72.                                 repeat
  73.                                     Err := ReadALine(readRef, logLine);
  74.                                     if FirstLine then
  75.                                         logLine := BeginStrip(logLine);
  76.                                     logLine := EndStrip(logLine);
  77.                                     logLine := TwoSpaceStrip(logLine);
  78.                                     if (not (logLine[1] in [SPACE, ';', '.', TAB])) & (not FirstLine) & (pos('Keywords:', logLine) <> 1) then
  79.                                         logLine := concat(SPACE, logLine);
  80.                                     if pos('Keywords:', logLine) <> 1 then
  81.                                         Err := Wr(writeRef, logLine)
  82.                                     else
  83.                                         Err := WrLn(writeRef, concat(ENDLINE, ENDLINE, logLine, ENDLINE));
  84.                                     FirstLine := false;
  85.                                 until (pos('Keywords:', logLine) = 1) | AtEOF(readRef) | (Err <> NoErr)
  86.                             end    {    if (not AtEOF(readRef)) & (Err = NoErr)    }
  87.                     end;        {    while not AtEOF(readRef) & (Err = NoErr)        }
  88.                 Err := FSClose(writeRef)
  89.             end
  90.     end;
  91.  
  92. {-----------------------------------------------------------------    }
  93.  
  94.     var
  95.         err: OSErr;
  96.         where: point;
  97.         reply: SFReply;
  98.         typeList: SFTypeList;
  99.         keepLooping: boolean;
  100.         currentLog: str255;
  101.         readRef: integer;
  102.  
  103. begin
  104.     MaxApplZone;
  105.     InitCursor;
  106.     typeList[0] := 'TEXT';
  107.     keepLooping := true;
  108.     where.v := 20;
  109.     where.h := 20;
  110.     while keepLooping = true do
  111.         begin
  112.             SFGetFile(where, '', nil, 1, typeList, nil, reply);
  113.             if reply.good then
  114.                 begin
  115.                     currentLog := reply.fName;
  116.                     Err := FSOpen(currentLog, reply.vRefNum, readRef);
  117.                     if (Err = NoErr) then
  118.                         begin
  119.                             SFPutFile(where, 'Please name report', concat(currentLog, '.clean'), nil, reply);
  120.                             if reply.good then
  121.                                 ProcessFile(reply.fName, readRef, reply.vRefNum)
  122.                             else
  123.                                 keepLooping := false
  124.                         end;
  125.                     Err := FSClose(readRef)
  126.                 end
  127.             else
  128.                 keepLooping := false
  129.         end
  130. end.